home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tpxms.com / XMSTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-07-30  |  10.3 KB  |  324 lines
  1. Program XMSTEST;
  2. Uses
  3.    CRT,TPXMS;
  4. Var
  5.    handle      : Word;
  6.    i           : Integer;
  7.    XMSVer,
  8.    XMSRev      : String;
  9.    ExtMemMove  : ExtMemMoveStruct;
  10.    EMBHandle   : EMBHandleStruct;
  11.    EMBAddress  : Bit32Struct;
  12.    UMBSegment  : UMBSegmentStruct;
  13.  
  14. Procedure GETKEY;
  15. Var
  16.    ch : Char;
  17. Begin
  18.    GoToXY(26,24);
  19.    Write('Press any key to continue ...');
  20.    ch := ReadKey;
  21.    If ch = #0 Then ch := Readkey
  22. End;
  23.  
  24. Function CHKXMS : Boolean;
  25. Begin
  26.    If NOT isXMS Then
  27.    Begin
  28.       Writeln('This program requires the following:');
  29.       Writeln('  An AT-Class or better computer (80286-80386)');
  30.       Writeln('  HIMEM.SYS successfully loaded from CONFIG.SYS');
  31.       Writeln('Program aborted.');
  32.       CHKXMS := FALSE
  33.    End
  34.    Else
  35.       CHKXMS := TRUE
  36. End;
  37.  
  38. Function CHKVER : Boolean;
  39. Const
  40.    NUMARY : Array[0..9] of Char = ('0','1','2','3','4','5','6','7','8','9');
  41. Var
  42.    i : Byte;
  43. Begin
  44.    GetVerHiMem;
  45.    If XMSResult < $0200 Then
  46.    Begin
  47.       Writeln('This program requires at least version 2.00 of HIMEM.SYS');
  48.       Writeln('Program aborted.');
  49.       CHKVER := FALSE;
  50.       Exit
  51.    End;
  52.    XMSVer := NUMARY[((Hi(XMSResult) AND $F0) SHR 4)];
  53.    If XMSVer = '0' Then XMSVer := '';
  54.    XMSVer := XMSVer + NUMARY[(Hi(XMSResult) AND $0F)] + '.';
  55.    XMSVer := XMSVer + NUMARY[((Lo(XMSResult) AND $F0) SHR 4)];
  56.    XMSVer := XMSVer + NUMARY[(Lo(XMSResult) AND $0F)];
  57.    GetRevHiMem;
  58.    XMSRev := NUMARY[((Hi(XMSResult) AND $F0) SHR 4)];
  59.    If XMSRev = '0' Then XMSRev := '';
  60.    XMSRev := XMSRev + NUMARY[(Hi(XMSResult) AND $0F)] + '.';
  61.    XMSRev := XMSRev + NUMARY[((Lo(XMSResult) AND $F0) SHR 4)];
  62.    XMSRev := XMSRev + NUMARY[(Lo(XMSResult) AND $0F)];
  63.    CHKVER := TRUE
  64. End;
  65.  
  66. Function CHKHMA : Boolean;
  67. Begin
  68.    GetMemHMA($FFFF);
  69.    If XMSResult <> 1 Then
  70.    Begin
  71.       Writeln('This program requires that the High Memory Area is clear.');
  72.       Writeln('Try rebooting the system and running this program again.');
  73.       Writeln('Program aborted.');
  74.       CHKHMA := FALSE
  75.    End
  76.    Else
  77.    Begin
  78.       FreeMemHMA;
  79.       CHKHMA := TRUE
  80.    End
  81. End;
  82.  
  83. Function CHKEXT : Boolean;
  84. Begin
  85.    QueryFreeMemXMS;
  86.    If XMSResult < 4 Then
  87.    Begin
  88.       Writeln('This program requires that the Extended Memory Area have');
  89.       Writeln('at least 4096 bytes free. You may not have enough memory');
  90.       Writeln('in your system or you need to deallocate some memory from');
  91.       Writeln('your RAM DISK or DISK CACHE. Please note that HIMEM.SYS is');
  92.       Writeln('incompatible with VDISK.SYS in versions of DOS below 4.00.');
  93.       Writeln('The RAMDRIVE program included with Windows/286/386 will work.');
  94.       Writeln('Program aborted.');
  95.       CHKEXT := FALSE
  96.    End
  97.    Else
  98.       CHKEXT := TRUE
  99. End;
  100.  
  101. Procedure TITLESCR;
  102. Begin
  103.    ClrScr;
  104.    GoToXY(19, 2);
  105.    Write('XMSTEST  v1.00   Written by Vernon E. Davis');
  106.    GoToXY(19, 4);
  107.    Write('Source Code for Turbo Pascal v4.x and above');
  108.    GoToXY(31, 7);
  109.    Write('XMS Version  : ',XMSVer);
  110.    GoToXY(31, 9);
  111.    Write('XMS Revision : ',XMSRev);
  112.    GoToXY( 7,12);
  113.    Write('This program will perform tests on HIMEM.SYS, the Extended Memory');
  114.    GoToXY( 7,13);
  115.    Write('Manager for AT-Class and above machines. All functions implemented');
  116.    GoToXY( 7,14);
  117.    Write('are current as of Revision Level 2.06 of HIMEM.SYS, dated 03/21/89.');
  118.    GoToXY( 7,15);
  119.    Write('Some of the functions allocated in this revision are not functional');
  120.    GoToXY( 7,16);
  121.    Write('( See the .DOC file for a list of these functions ). If you have');
  122.    GoToXY( 7,17);
  123.    Write('gotten this far, you have at least 4096 bytes free of Extended');
  124.    GoToXY( 7,18);
  125.    Write('Memory and the High Memory Address area is clear. This program will');
  126.    GoToXY( 7,19);
  127.    Write('provide an idea of how to write code for utilizing the HMA and XMS');
  128.    GoToXY( 7,20);
  129.    Write('functions provided by HIMEM.SYS. All code in the TPXMS Unit is Pascal');
  130.    GoToXY( 7,21);
  131.    Write('with Inline function calls to the XMM_Control routine. Studying this');
  132.    GoToXY( 7,22);
  133.    Write('test program will enable you to take full advantage of HIMEM.SYS.');
  134.    GoToXY(28,24);
  135.    GETKEY
  136. End;
  137.  
  138. Procedure TSTA20;
  139.  
  140.    Function STATA20 : String;
  141.    Begin
  142.       QueryA20;
  143.       If XMSResult = 1 Then
  144.          STATA20 := 'A20 is enabled.'
  145.       Else
  146.          STATA20 := 'A20 is disabled.'
  147.    End;
  148.  
  149. Begin
  150.    ClrScr;
  151.    Writeln;
  152.    Writeln('This test determines if the 21st address line (A20) is usable.');
  153.    Writeln('The Global commands are used when addressing the HMA area.');
  154.    Writeln('The Local  commands are used when addressing Extended Memory.');
  155.    Writeln('The lines below should correspond to the status of the A20 line.');
  156.    Writeln('If not, there might be a problem with the line on your system.');
  157.    Writeln('The Current status should start as "A20 is disabled".');
  158.    Writeln('If there is a problem, try rebooting the system.');
  159.    Writeln;
  160.    Writeln;
  161.    GetMemHMA($FFFF);
  162.    Writeln('Current status of A20     ... ',STATA20);
  163.    GlobalEnableA20;
  164.    Writeln('Attempting Global Enable  ... ',STATA20);
  165.    GlobalDisableA20;
  166.    Writeln('Attempting Global Disable ... ',STATA20);
  167.    LocalEnableA20;
  168.    Writeln('Attempting Local Enable   ... ',STATA20);
  169.    LocalDisableA20;
  170.    Writeln('Attempting Local Disable  ... ',STATA20);
  171.    FreeMemHMA;
  172.    GETKEY
  173. End;
  174.  
  175. Procedure TSTEXT;
  176. Begin
  177.    ClrScr;
  178.    QueryFreeMemXMS;
  179.    Writeln('Total Free Extended Memory in kilobytes       : ',XMSResult);
  180.    QueryFreeBlockXMS;
  181.    Writeln('Largest Block of Extended Memory in kilobytes : ',XMSResult);
  182.    Writeln;
  183.    Writeln;
  184.    Writeln('Next, we''ll test the Extended Memory Allocate and Lock Functions.');
  185.    Writeln('The two numbers above indicate the total Extended Memory and the');
  186.    Writeln('largest available block, respectively. Now we''ll allocate 4096');
  187.    Writeln('bytes (4KB) of memory for our test.');
  188.    GETKEY;
  189.    ClrScr;
  190.    handle := AllocExtMemBlockXMS(4);
  191.    QueryFreeMemXMS;
  192.    Writeln('Total Free Extended Memory in kilobytes       : ',XMSResult);
  193.    QueryFreeBlockXMS;
  194.    Writeln('Largest Block of Extended Memory in kilobytes : ',XMSResult);
  195.    Writeln;
  196.    Writeln;
  197.    EMBHandleInfoXMS(handle,EMBHandle);
  198.    With EMBHandle Do
  199.    Begin
  200.       Writeln('Extended Memory Block Information:');
  201.       Writeln;
  202.       Writeln('Lock Count                : ',LockCount);
  203.       Writeln('Free Handles              : ',FreeHandles);
  204.       Writeln('Block Length in Kilobytes : ',BlockLenKB)
  205.    End;
  206.    Writeln;
  207.    Writeln;
  208.    Writeln('The "Total Free" and "Largest Block" numbers have decreased by 4');
  209.    Writeln('as we allocated 4 kilobytes for our test. The block allocated has');
  210.    Writeln('the 4 kilobytes as displayed in the "Block Length" information.');
  211.    Writeln('Also, the number of free Extended Memory handles has decreased by');
  212.    Writeln('one and the Lock Count is zero because we have not locked the block');
  213.    Writeln('yet. Let''s now lock the block.');
  214.    GETKEY;
  215.    ClrScr;
  216.    EMBAddress := LockExtMemBlockXMS(handle);
  217.    QueryFreeMemXMS;
  218.    Writeln('Total Free Extended Memory in kilobytes       : ',XMSResult);
  219.    QueryFreeBlockXMS;
  220.    Writeln('Largest Block of Extended Memory in kilobytes : ',XMSResult);
  221.    Writeln;
  222.    Writeln;
  223.    EMBHandleInfoXMS(handle,EMBHandle);
  224.    With EMBHandle Do
  225.    Begin
  226.       Writeln('Extended Memory Block Information:');
  227.       Writeln;
  228.       Writeln('Lock Count                : ',LockCount);
  229.       Writeln('Free Handles              : ',FreeHandles);
  230.       Writeln('Block Length in Kilobytes : ',BlockLenKB);
  231.       Writeln('Block Address             : ',EMBAddress)
  232.    End;
  233.    UnlockExtMemBlockXMS(handle);
  234.    FreeExtMemBlockXMS(handle);
  235.    Writeln;
  236.    Writeln;
  237.    Writeln('Now notice that the Lock Count has increased by one. Also note');
  238.    Writeln('the Block Address. This is shown for curiosity only. Remember');
  239.    Writeln('that since this address is a 32-bit unsigned number, and it is');
  240.    Writeln('stored in Turbo Pascal as a LongInt, which is a 32-bit SIGNED');
  241.    Writeln('number, its value may or may not be actually true ( See the .DOC');
  242.    Writeln('file for further information ).');
  243.    GETKEY
  244. End;
  245.  
  246. Procedure TSTMOV;
  247. Begin
  248.    ClrScr;
  249.    GoToXY( 5, 9);
  250.    Writeln('Next, we''ll test the Extended Memory Move Function. This function is');
  251.    GoToXY( 5,10);
  252.    Writeln('called with a pointer to a structure which contains the length in bytes');
  253.    GoToXY( 5,11);
  254.    Writeln('to move, the Handles of the Source and Destination and the addresses of');
  255.    GoToXY( 5,12);
  256.    Writeln('the Source and Destination. We''ll write 1999 letter "A"s to the screen');
  257.    GoToXY( 5,13);
  258.    Writeln('and save them to Extended Memory. Then we''ll clear the screen and move');
  259.    GoToXY( 5,14);
  260.    Writeln('them back to the screen.');
  261.    GETKEY;
  262.    handle := AllocExtMemBlockXMS(4);
  263.    EMBAddress := LockExtMemBlockXMS(handle);
  264.    With ExtMemMove Do
  265.    Begin
  266.       Length := 4000;
  267.       SourceHandle := 0;
  268.       SourceOffset := $B8000000;
  269.       DestHandle := handle;
  270.       DestOffset := 0
  271.    End;
  272.    GoToXY(1,1);
  273.    For i := 1 To 1999 Do Write('A');
  274.    GETKEY;
  275.    MoveExtMemBlockXMS(ExtMemMove);
  276.    ClrScr;
  277.    GoToXY(20,12);
  278.    Writeln('Now, we''ll write them back from Extended Memory.');
  279.    GETKEY;
  280.    With ExtMemMove Do
  281.    Begin
  282.       Length := 4000;
  283.       SourceHandle := handle;
  284.       SourceOffset := 0;
  285.       DestHandle := 0;
  286.       DestOffset := $B8000000
  287.    End;
  288.    MoveExtMemBlockXMS(ExtMemMove);
  289.    GETKEY;
  290.    ClrScr;
  291.    UnlockExtMemBlockXMS(handle);
  292.    FreeExtMemBlockXMS(handle)
  293. End;
  294.  
  295. Procedure ENDSCR;
  296. Begin
  297.    ClrScr;
  298.    GoToXY( 4, 9);
  299.    Writeln('This now concludes XMSTEST. For further information about HIMEM.SYS,');
  300.    GoToXY( 4,10);
  301.    Writeln('see the documentation included with this program. It is advisable to');
  302.    GoToXY( 4,11);
  303.    Writeln('also obtain the XMS Specification from Microsoft by either download');
  304.    GoToXY( 4,12);
  305.    Writeln('or direct from Microsoft. Thank you for your support,');
  306.    GoToXY( 4,14);
  307.    Writeln('Vernon E. Davis  07/30/89');
  308.    GETKEY;
  309.    ClrScr
  310. End;
  311.  
  312. Begin
  313.    If NOT CHKXMS Then Halt(1);
  314.    If NOT CHKVER Then Halt(1);
  315.    If NOT CHKHMA Then Halt(1);
  316.    If NOT CHKEXT Then Halt(1);
  317.    TITLESCR;
  318.    TSTA20;
  319.    TSTEXT;
  320.    TSTMOV;
  321.    ENDSCR;
  322.    Halt(0)
  323. End.
  324.